home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 1 / PC Actual CD 01.iso / share / dos / utilidad / comptest.arj / COMPTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-26  |  54.3 KB  |  1,456 lines
  1. PROGRAM CompTest; { Copyright (c) 1988-1994 Norbert Juffa }
  2.  
  3. {$A+,B-,D-,E+,F-,G-,I-,L-,N+,O-,R-,S-,V-,X-}
  4. {$M 4096,0,655360}
  5.  
  6. USES DOS, Crt, Time, Whet, Dhry, LLL, Caches;
  7.  
  8. CONST
  9.    MaxBufSize= 65500;
  10.    ClockFreq = 1.193182e6;
  11.  
  12.  
  13. TYPE
  14.    LongWord  = ARRAY [1..2] OF WORD;
  15.    IOPuffer  = ARRAY [1..MaxBufSize] OF BYTE;
  16.    PufferZgr = ^IOPuffer;
  17.    Processor = (NA, i88, i86, V20, V30, i188, i186, i286, i386, i386sx, ct386,
  18.                 ct386sx, c486dlc, c486slc, rapidcad, i486, i486sx, iDX4,
  19.                 Pentium, Overdrive);
  20.    CardType  = (MDA, CGA, Herkules, EGA, MCGA, VGA, PGA);
  21.    ResultRec = RECORD
  22.                   CPUType: BYTE;
  23.                   NDPType: BYTE;
  24.                   AAMTime: INTEGER;
  25.                   Dummy1:  INTEGER;
  26.                   MoveWTime,
  27.                   BIOSWriteTime, MoveBTime, EMS_Time, Ext_Time, ScreenFillTime,
  28.                   Dummy2, Speed87, Speed287, MoveDTime: INTEGER;
  29.                END;
  30.  
  31.  
  32.  
  33. CONST
  34.    SIOBase:     ARRAY [1..4] OF WORD =
  35.                 ($3F8, $2F8, $3E8, $2E8);
  36.    SIOTypeStr:  ARRAY [1..5] OF STRING [7] =
  37.                 ('8250', '16450', '16550', '16550A', 'unknown');
  38.    BusWidth:    ARRAY [i88 .. overdrive] OF BYTE =
  39.                 (8, 16, 8, 16, 8, 16, 16, 32, 16, 32, 16,
  40.                  32, 16, 32, 32, 32, 32, 32, 32);
  41.    AAM_Time:    ARRAY [i88 .. overdrive] OF INTEGER =
  42.                 (77, 77, 15, 15, 19, 19, 16, 17, 17, 16, 16,
  43.                  17, 17, 15, 15, 15, 15, 18, 15);
  44.    FillTime:    ARRAY [i88 .. overdrive] OF INTEGER =
  45.                 (10, 10, 4, 4, 9, 9, 3, 5, 5, 5, 5,
  46.                 4, 4, 4, 4, 4, 4, 1, 4);
  47.    MoveTime:    ARRAY [i88 .. overdrive] OF INTEGER =
  48.                 (25, 17, 8, 16, 8, 16, 4, 4, 8, 4, 8,
  49.                 4, 4, 5, 3, 3, 3, 1, 3);
  50.    LFaktor:     ARRAY [i88 .. overdrive] OF REAL =
  51.                 (1, 1.45, 1.15, 1.78, 1.15, 1.78, 3.3, 4.1, 3.4,
  52.                  4.5, 3.7, 5.0, 6.0, 6.5, 8.5, 8.5, 8.5, 17, 8.5);
  53.    CPU_Name:    ARRAY [i88 .. overdrive] OF STRING [15] =
  54.                 ('Intel 8088', 'Intel 8086', 'NEC V20', 'NEC V30',
  55.                  'Intel 80188', 'Intel 80186', 'Intel 80286',
  56.                  'Intel 80386', 'Intel 80386SX', 'C&T 38600DX',
  57.                  'C&T 38600SX', 'Cyrix 486DLC', 'Cyrix 486SLC',
  58.                  'Intel RapidCAD', 'Intel 80486',
  59.                  'Intel 80486SX', 'Intel DX4',
  60.                  'Intel Pentium', 'Intel Overdrive');
  61.    CoProcessor: ARRAY [0 .. 30] OF STRING [19] =
  62.                 ('NOT INSTALLED', 'Emulation via INT 7', 'Intel 8087',
  63.                  'Intel 80C187', 'Intel 80287', 'Intel 80287XL', 'Intel 80387',
  64.                  'Intel 80387sx', 'IIT 2C87', 'IIT 2C87', 'IIT 3C87',
  65.                  'IIT 3C87sx', 'Cyrix 82S87 (old)', 'Cyrix 82S87 (old)',
  66.                  'Cyrix 83D87', 'Cyrix 83S87 (old)', 'ULSI 83C87', 'ULSI 83S87',
  67.                  'C&T 38700DX', 'C&T 38700SX', 'Intel 80387DX', 'Intel RapidCAD',
  68.                  'Intel 486', 'Cyrix 82S87 (new)', 'Cyrix 82S87 (new)',
  69.                  'Cyrix 387+', 'Cyrix 83S87 (new)', 'Cyrix EMC87',
  70.                  'Intel Pentium', 'Intel DX4', 'Intel Overdrive');
  71.    Installed:   ARRAY [FALSE..TRUE] OF STRING [13] =
  72.                 ('NOT INSTALLED', 'INSTALLED');
  73.    Computer:    ARRAY [$F5..$FF] OF STRING [14] =
  74.                 ('PS/2 Model 60', 'PS/2 Model 50', 'XT-286', 'PS/2 Model 80',
  75.                  'Laptop', 'PS/2 Model 30', 'XT', 'AT', 'PCjr', 'XT / Portable',
  76.                  'PC');
  77.    CardMemBegin:ARRAY [MDA .. PGA] OF WORD =
  78.                 ($B000, $B800, $B000, $A000, $A000, $A000, $A000);
  79.    CardName:    ARRAY [MDA .. PGA] OF STRING [37] =
  80.                 ('Monochrome Display Adapter (MDA)',
  81.                  'Color Graphics Adapter (CGA)',
  82.                  'Hercules Graphics Card (HGC)',
  83.                  'Enhanced Graphics Adapter (EGA)',
  84.                  'Multi Color Graphics Array (MCGA)',
  85.                  'Video Graphics Array (VGA)',
  86.                  'Professional Graphics Adapter (PGA)');
  87.  
  88.  
  89. VAR
  90.    SIOType:                                         ARRAY [1..4] OF BYTE;
  91.  
  92.    SIOCtrl, SIOStat, SerOut, DataWidth, SaveByte,
  93.    ConfigStatHi, ConfigStatLo, DOS_Drives,
  94.    NrOfHardDisks, NrOfFloppies, EGAInfo, DriveByte,
  95.    ErrByte, NrHD, NrDD, Nr3DD, Nr3HD, Drive1,
  96.    Drive2, Typ, Head1, K:                           BYTE;
  97.  
  98.    MemExists, GamesAdaptor, MousePresent,
  99.    ExtendedMem, ExpandedMem, MonoChromMode,
  100.    Disktest, OldMemExists, ExtraRAMFound, EGAPres,
  101.    VGAPres, ANSIPresent, Debug, Emu, Weitek,
  102.    PortExists:                                      BOOLEAN;
  103.  
  104.    Ch:                                              CHAR;
  105.  
  106.    ScreenWaits, Segment, OldSegment, NrParallelPorts,
  107.    NrSerialPorts, DefaultDr, ExtendedMemSize,
  108.    ExpandedMemSize, SystemMemory, L, DOS_Memory,
  109.    EGAMem, UsedMemory, BufSeg, BufOff, Head,
  110.    Dummy, Track, RAMBeg, ROMSize, EMS_Base,
  111.    FillSize, FirstLevel, SecondLevel, SPC,
  112.    SegTest, OfsTest, ChkSum:                        WORD;
  113.  
  114.    Start, DOSWriteTime, BIOSWriteTime, SavedTime,
  115.    CacheTstTime, HeapPointer:                       LONGINT;
  116.  
  117.    MoveTakte, MoveWTakte, FillTakte, Frequency,
  118.    Waitstates, Cache2Thru, Frequency87, Durchsatz,
  119.    EMS_Thruput, Ext_Thruput, DOSSpeed, CacheThru,
  120.    MemThru, BIOSSpeed, Index, Version, ThruPut:     REAL;
  121.  
  122.    MegaFlops, Dhrys, Whets:                         DOUBLE;
  123.    Fil:                                             TEXT;
  124.    EMS_Version:                                     STRING [3];
  125.    ComputerType, ScreenType:                        STRING [35];
  126.    ProcessorType:                                   STRING [15];
  127.    DiskTypeStr, DriveStr:                           STRING [45];
  128.    TestStr:                                         STRING [86];
  129.    ScreenAddr:                                      POINTER;
  130.    CPU:                                             Processor;
  131.    GraphCard:                                       CardType;
  132.    Regs:                                            Registers;
  133.    Result:                                          ResultRec;
  134.    DummyPtr, BufPtr:                                PufferZgr;
  135.    MoveBuffer:                                      POINTER;
  136.    Heads, Sectors, DOSCylinders, Tracks, Cylinders: ARRAY [$80..$83] OF WORD;
  137.    Capacity, CylSize:                               ARRAY [$80..$83] OF LONGINT;
  138.    Valid:                                           ARRAY [$80..$83] OF BOOLEAN;
  139.    MaximumAccess, AverageAccess, TrackToTrack,
  140.    DiskThruPut:                                     ARRAY [$80..$83] OF REAL;
  141.    CacheOn:                                         ARRAY [$80..$83] OF BOOLEAN;
  142.    InfoBuf:                                         ARRAY [0..64] OF BYTE;
  143.  
  144.  
  145.  
  146. {$L CCNEW.OBJ}
  147.  
  148. PROCEDURE SpeedTest (Debg, Ext_Flag, EMS_Flag: WORD;
  149.                      EPtr, Bptr, Sptr: POINTER;
  150.                      VAR Results: ResultRec); NEAR; EXTERNAL;
  151.  
  152.  
  153.  
  154. FUNCTION EMM_Installed: BOOLEAN;
  155.  
  156. VAR
  157.   EMM_Name: String[8];
  158.   Regs    : Registers;
  159.  
  160. BEGIN
  161.    EMM_Name := '        ';
  162.    Regs.AH := $35;
  163.    Regs.AL := $67;
  164.    Intr ($21, Regs);
  165.    Move (Mem [Regs.ES:$0A], EMM_Name[1], 8);
  166.    EMM_Installed := (EMM_Name = 'EMMXXXX0');
  167. END;
  168.  
  169.  
  170.  
  171. FUNCTION EMS_Memory: INTEGER;
  172. VAR Regs: Registers;
  173. BEGIN
  174.     Regs.AH    := $42;
  175.     Intr ($67, Regs);
  176.     EMS_Memory := Regs.DX * 16;
  177. END;
  178.  
  179.  
  180. FUNCTION GetEMSVersion: STRING;
  181. VAR Regs: Registers;
  182. BEGIN
  183.    Regs.AH := $46;
  184.    Intr ($67, Regs);
  185.    GetEMSVersion := Char (Regs.AL SHR 4 + 48) + '.' + Char(Regs.AL AND $F +48); { dito für Neben-Versionsnummer }
  186. END;
  187.  
  188.  
  189.  
  190. FUNCTION CheckMouse: BOOLEAN;
  191. VAR Regs: Registers;
  192. BEGIN
  193.    Regs.AX := 5;                 { get button press information (destroys AX) }
  194.    Regs.BX := 0;                 { left button }
  195.    Intr ($33, Regs);
  196.    CheckMouse := (Regs.AX <> 5);
  197. END;
  198.  
  199.  
  200.  
  201. FUNCTION GetEMSBase: WORD;
  202. VAR Regs: Registers;
  203. BEGIN
  204.    Regs.AH := $41;
  205.    Intr ($67, Regs);
  206.    GetEMSBase := Regs.BX;
  207. END;
  208.  
  209.  
  210.  
  211. {$F+}
  212. FUNCTION HeapFunc (Size: WORD): INTEGER;
  213. {$F-}
  214. BEGIN
  215.    HeapFunc := 1;
  216. END;
  217.  
  218.  
  219.  
  220. FUNCTION HercPresent: BOOLEAN;
  221. BEGIN
  222.    Inline($BB/$00/$01/$BA/$BA/$03/$EC/$88/$C4/$80/$E4/$80/$B9/$40/$00/$EC/
  223.           $24/$80/$38/$E0/$E1/$F9/$75/$05/$4B/$75/$F1/$EB/$33/$B8/$00/$B0/
  224.           $8E/$C0/$E8/$11/$00/$75/$0B/$B0/$01/$BA/$BF/$03/$EE/$E8/$06/$00/
  225.           $74/$1E/$B0/$01/$EB/$1C/$26/$8A/$1E/$FF/$7F/$26/$8A/$0E/$FF/$3F/
  226.           $26/$FE/$06/$FF/$3F/$26/$3A/$1E/$FF/$3F/$26/$88/$0E/$FF/$3F/$C3/
  227.           $30/$C0/$88/$46/$FF/$08/$C0);
  228. END;
  229.  
  230.  
  231. FUNCTION Hex (X: WORD): STRING;
  232. VAR H: ARRAY [0..15] OF CHAR;
  233. BEGIN
  234.    H := '0123456789ABCDEF';
  235.    Hex := H [X SHR 12] + H [(X AND $0F00) SHR 8] +
  236.           H [(X AND $00F0) SHR 4] + H [(X AND $000F)];
  237. END;
  238.  
  239.  
  240.  
  241. PROCEDURE SearchExtraRAM (FileWrite: BOOLEAN);
  242. BEGIN
  243.    ExtraRAMFound := FALSE;
  244.    IF SystemMemory * 64 < CardMemBegin [GraphCard] THEN
  245.       Segment := SystemMemory * 64
  246.    ELSE
  247.       Segment := $C000;
  248.    MemExists := FALSE;
  249.    WHILE Segment < $FC00 DO BEGIN
  250.       Inline ($54/$58/$3B/$C4/$74/$0C/$B0/$00/$E6/$A0/
  251.               $E4/$61/$0C/$30/$E6/$61/$EB/$0E/$E4/$70/
  252.               $0C/$80/$E6/$70/$E4/$71/$E4/$61/$0C/$0C/
  253.               $E6/$61/$FA);
  254.       OldMemExists := MemExists;
  255.       SaveByte := Mem [Segment:0];
  256.       Mem [Segment:0] := $55;
  257.       Dummy := Mem [Segment:0];
  258.       MemExists := (Dummy = $55);
  259.       Mem [Segment:0] := $AA;
  260.       Dummy := Mem [Segment:0];
  261.       MemExists := MemExists AND (Dummy = $AA);
  262.       Mem [Segment:0] := SaveByte;
  263.       Inline ($54/$58/$3B/$C4/$74/$0C/$E4/$61/$34/$30/
  264.               $E6/$61/$B0/$80/$E6/$A0/$EB/$0E/$E4/$61/
  265.               $34/$0C/$E6/$61/$E4/$70/$24/$7F/$E6/$70/
  266.               $E4/$71/$FB);
  267.       IF Segment = EMS_Base THEN
  268.          MemExists := FALSE;
  269.       IF Segment = CardMemBegin [GraphCard] THEN
  270.          MemExists := FALSE;
  271.       IF MemExists AND (NOT OldMemExists) THEN BEGIN
  272.          ExtraRAMFound := TRUE;
  273.          RAMBeg := Segment;
  274.          END;
  275.       IF (NOT MemExists) AND OldMemExists THEN BEGIN
  276.          IF FileWrite THEN
  277.             Write (Fil, Hex (RAMBeg)+'0', '-', Hex (Segment-1)+'F (',
  278.                   (Segment-RAMBeg) DIV 64:3 , ' KB)', #13#10, ' ':37)
  279.          ELSE
  280.             Write (Hex (RAMBeg)+'0', '-', Hex (Segment-1)+'F (',
  281.                   (Segment-RAMBeg) DIV 64:3 , ' KB)', #13#10, ' ':37);
  282.          END;
  283.       IF Segment = CardMemBegin [GraphCard] THEN
  284.          Segment := $BFF0;
  285.       IF Segment = EMS_Base THEN BEGIN
  286.          IF FileWrite THEN
  287.             Write (Fil, Hex (EMS_Base)+'0', '-', Hex (EMS_Base+$0FFF)+'F ( 64 KB)',
  288.                    ' EMS-frame', #13#10, ' ':37)
  289.          ELSE
  290.             Write (Hex (EMS_Base)+'0', '-', Hex (EMS_Base+$0FFF)+'F ( 64 KB)',
  291.                    ' EMS-frame', #13#10, ' ':37);
  292.          Inc (Segment, $1000);
  293.          END
  294.       ELSE
  295.          Inc (Segment, $10);
  296.    END;
  297.    IF (NOT ExtraRAMFound) AND ((NOT ExpandedMem) OR (EMS_BASE > $F000)) THEN
  298.       IF FileWrite THEN
  299.          WriteLn (Fil, 'NOT FOUND')
  300.       ELSE
  301.          WriteLn ('NOT FOUND');
  302. END;
  303.  
  304.  
  305. PROCEDURE SearchROM (FileWrite: BOOLEAN);
  306. VAR Vector_41: POINTER;
  307.     Vector_57: POINTER;
  308. BEGIN
  309.    GetIntVec ($41, Vector_41);
  310.    GetIntVec ($57, Vector_57);
  311.    ExtraRAMFound := FALSE;
  312.    Segment := $C000;
  313.    OldSegment := 0;
  314.    WHILE (Segment < $F000) AND (OldSegment < Segment) DO BEGIN
  315.       OldSegment := Segment;
  316.       IF MemW [Segment:0] = $AA55 THEN BEGIN
  317.          ROMSize := Mem [Segment:2] DIV 2;
  318.          Inline ($FC/$8B/$0E/ROMSize/$86/$CD/$D1/$E1/$D1/$E1/$31/
  319.                  $F6/$89/$F3/$A1/Segment/$1E/$8E/$D8/$AC/$00/$C3/
  320.                  $E2/$FB/$1F/$89/$1E/ChkSum);
  321.          IF ChkSum = 0 THEN BEGIN
  322.             ExtraRAMFound := TRUE;
  323.             IF FileWrite THEN
  324.                Write (Fil, Hex(Segment)+'0', '-', Hex(Segment+ROMSize * 64-1)+'F (',
  325.                       ROMSize:3, ' KB)')
  326.             ELSE
  327.                Write (Hex(Segment)+'0', '-', Hex(Segment+ROMSize * 64-1)+'F (',
  328.                       ROMSize:3, ' KB)');
  329.             IF (Seg(Vector_41^) = Segment) THEN
  330.                 IF FileWrite THEN
  331.                    Write (Fil, ' Harddisk-BIOS')
  332.                 ELSE
  333.                    Write (' Harddisk-BIOS');
  334.              IF (Segment = Seg(Vector_57^)) THEN
  335.                 IF FileWrite THEN
  336.                    Write (Fil, ' NetBIOS-ROM')
  337.                 ELSE
  338.                    Write (' NetBIOS-ROM');
  339.              IF (Segment = $C000) THEN
  340.                 IF VGAPres THEN
  341.                    IF FileWrite THEN
  342.                       Write (Fil, ' VGA-BIOS')
  343.                    ELSE
  344.                       Write (' VGA-BIOS')
  345.                 ELSE IF EGAPres THEN
  346.                    IF FileWrite THEN
  347.                       Write (Fil, ' EGA-BIOS')
  348.                    ELSE
  349.                       Write (' EGA-BIOS');
  350.             IF FileWrite THEN
  351.                Write (Fil, #13#10, ' ':37)
  352.             ELSE
  353.                Write (#13#10, ' ':37);
  354.             Inc (Segment, ROMSize * 64)
  355.             END
  356.          ELSE
  357.             Inc (Segment, $10);
  358.          END
  359.       ELSE
  360.          Inc (Segment, $10);
  361.     END;
  362.     IF NOT ExtraRAMFound THEN
  363.        IF FileWrite THEN
  364.           WriteLn (Fil, 'NOT FOUND')
  365.        ELSE
  366.           WriteLn ('NOT FOUND');
  367. END;
  368.  
  369.  
  370.  
  371. PROCEDURE ReserveMem;
  372. BEGIN
  373.    BufPtr := NIL;
  374.    IF CylSize [L] > LongInt (MaxBufSize) THEN BEGIN
  375.       SPC := MaxBufSize DIV 512;
  376.       CylSize [L] := SPC * 512;
  377.       END;
  378.    HeapPointer := LONGINT (LongWord(HeapPtr)[2]) * 16 + LongWord(HeapPtr)[1];
  379.    FillSize := $10000 - HeapPointer MOD $10000;
  380.    GetMem (DummyPtr, FillSize);
  381.    IF DummyPtr = NIL THEN BEGIN
  382.       WriteLn (#13#10#10'Not enough memory to test hard disk(s)');
  383.       Halt;
  384.    END;
  385.    GetMem (BufPtr, Word (CylSize[L]+16));
  386.    IF BufPtr = NIL THEN BEGIN
  387.       WriteLn (#13#10#10'Not enough memory to test hard disk(s)');
  388.       Halt;
  389.       END;
  390. END;
  391.  
  392.  
  393.  
  394. BEGIN
  395.    Debug := (ParamStr (ParamCount) = '-D') OR (ParamStr (ParamCount) = '-d') OR
  396.             (ParamStr (ParamCount) = '/D') OR (ParamStr (ParamCount) = '/d');
  397.    IF (ParamStr (ParamCount) = '-H') OR (ParamStr (ParamCount) = '-h') OR
  398.       (ParamStr (ParamCount) = '/H') OR (ParamStr (ParamCount) = '/h') OR
  399.       (ParamStr (ParamCount) = '/?') OR (ParamStr (ParamCount) = '-?') THEN BEGIN
  400.        WriteLn (#10#13, 'COMPTEST tests the performance of your PC compatible computer');
  401.        WriteLn (#10#13, 'usage: COMPTEST [file name] [/D] [/H]');
  402.        WriteLn (#10#13, 'file name: saves the test results in file specified');
  403.        WriteLn (        '/D:        enables additional debugging messages');
  404.        WriteLn (        '/H:        displays this information');
  405.        WriteLn;
  406.        Halt (0);
  407.        END;
  408.  
  409.    Regs.AH := 0;                         { switch off diskette motor }
  410.    Regs.DL := 0;                         { recalibrate diskettes only }
  411.    Intr ($13, Regs);
  412.  
  413.    DirectVideo := TRUE;
  414.    CheckBreak  := FALSE;
  415.  
  416.    HeapError := @HeapFunc;
  417.  
  418.    GetMem (MoveBuffer, 20000);
  419.    IF MoveBuffer = NIL THEN BEGIN
  420.       WriteLn ('Not enough memory to execute COMPTEST');
  421.       Halt;
  422.       END;
  423.  
  424.    WITH Result DO BEGIN
  425.  
  426.    {-------------------------------------------------------------------------
  427.      determine computer type
  428.    --------------------------------------------------------------------------}
  429.  
  430.    Typ := Mem [$FFFF:$000E];
  431.    Regs.AH := $C0;                       { get system description table }
  432.    Intr ($15, Regs);
  433.    IF Debug AND ((Regs.Flags AND FCarry) = 0) THEN BEGIN
  434.       WriteLn ('computer type: ', Hex (MemW [Regs.ES:Regs.BX+2]));
  435.       ReadLn;
  436.       END;
  437.    IF ((Regs.Flags AND FCarry) = 0) AND (Mem [Regs.ES:Regs.BX+2] = $FC) THEN
  438.       CASE Mem [Regs.ES:Regs.BX+3] OF
  439.          $02: Typ := $F7;                { XT-286 }
  440.          $04: Typ := $F6;                { PS/2 Model 50 }
  441.          $05: Typ := $F5;                { PS/2 Model 60 }
  442.       END;
  443.    IF Typ < $F5 THEN
  444.       ComputerType := 'Unknown'
  445.    ELSE
  446.       ComputerType := 'IBM ' + Computer [Typ] + ' or compatible';
  447.  
  448.  
  449.    {-------------------------------------------------------------------------
  450.      determine equipment
  451.    --------------------------------------------------------------------------}
  452.  
  453.    Intr ($11, Regs);                     { get BIOS equipment flag }
  454.    NrParallelPorts := (Regs.AH AND $C0) SHR 6;
  455.    GamesAdaptor    := (Regs.AH AND $10) <> 0;
  456.    NrSerialPorts   := (Regs.AH AND $6) SHR 1;
  457.    NrOfFloppies    := (Regs.AL AND $C0) SHR 6 + (Regs.AL AND 1);
  458.    MousePresent    := CheckMouse;
  459.  
  460.    IF NOT GamesAdaptor THEN
  461.       GamesAdaptor := (Port [$201] AND $F) = 0;
  462.  
  463.    IF Debug THEN WriteLn ('About to perform SIO-Test');
  464.  
  465.    Dummy := 0;
  466.    FOR L := 1 TO 4 DO BEGIN
  467.       SIOType [L] := 0;
  468.       SIOCtrl := Port [SIOBase [L] + 4];
  469.       Port [SIOBase [L] + 4] := SIOCtrl OR $10;
  470.       SIOStat := Port [SIOBase [L] + 6];
  471.       Port [SIOBase [L] + 4] := $1A;
  472.       SerOut := Port [SIOBase [L] + 6] AND $F0;
  473.       Port [SIOBase [L] + 4] := SIOCtrl;
  474.       Port [SIOBase [L] + 6] := SIOStat;
  475.       IF SerOut = $90 THEN BEGIN
  476.          Inc (Dummy);
  477.          SIOType [L] := 1;
  478.          K := Port [SIOBase [L]+7];
  479.          IF K = Port [SIOBase [L]+7] THEN BEGIN
  480.             PortExists := TRUE;
  481.             FOR K := 0 TO 255 DO BEGIN
  482.                 Port [SIOBase [L]+7] := K;
  483.                 Delay (1);
  484.                 PortExists := PortExists AND (K = Port [SIOBase [L]+7]);
  485.             END;
  486.             IF PortExists THEN BEGIN
  487.                Inc (SIOType [L]);
  488.                Port [SIOBase [L] + 2] := $01;
  489.                SIOStat := Port [SIOBase [L] + 2] AND $C0;
  490.                IF SIOStat = $C0 THEN
  491.                   SIOType [L] := 4
  492.                ELSE IF SIOStat = $80 THEN
  493.                   SIOType [L] := 3
  494.                ELSE IF SIOStat = 0 THEN
  495.                   SIOType [L] := 2
  496.                ELSE
  497.                   SIOType [L] := 5;
  498.                Port [SIOBase [L] + 2] := 0;
  499.                END; { if portexists...}
  500.             END; { if k...}
  501.          END; { if serout...}
  502.    END; { for l ... }
  503.  
  504.    IF Dummy > NrSerialPorts THEN
  505.       NrSerialPorts := Dummy;
  506.  
  507.  
  508.    {-------------------------------------------------------------------------
  509.      determine graphics card
  510.    --------------------------------------------------------------------------}
  511.  
  512.    Regs.AX := $1B00;                     { get VGA state information }
  513.    Regs.BX := 0;                         { implementation type }
  514.    Regs.ES := Seg (InfoBuf);             { buffer for }
  515.    Regs.DI := Ofs (InfoBuf);             { return information }
  516.    Intr ($10, Regs);                     { try to call VGA Bios }
  517.    VGAPres := (Regs.AL = $1B);           { VGA if AL = AH on return }
  518.  
  519.    Regs.AH := $12;                       { get EGA hardware configuration }
  520.    Regs.BX := $FF10;
  521.    Intr ($10, Regs);                     { try to call EGA Bios }
  522.    EGAPres := (Regs.BH <> $FF);          { EGA, if BH <> $FF }
  523.    EGAMem  := Lo (Regs.BX) * 64 + 64;    { size of EGA screen memory in KB }
  524.  
  525.    Regs.AH := $0F;                       { get screen status }
  526.    Intr ($10, Regs);                     { BIOS video interupt }
  527.    MonoChromMode := Regs.AL = 7;
  528.  
  529.    Regs.AX := $1A00;                     { get screen combination code }
  530.    Intr ($10, Regs);                     { call PS/2 BIOS }
  531.    IF (Regs.AL = $1A) AND (Regs.BL>= $A) AND (Regs.BL <= $C) THEN
  532.       GraphCard := MCGA
  533.    ELSE IF (Regs.AL = $1A) AND (Regs.BL = 6) THEN
  534.       GraphCard := PGA
  535.    ELSE IF MonoChromMode THEN
  536.       IF VGAPres THEN
  537.          GraphCard := VGA
  538.       ELSE IF EGAPres THEN
  539.          GraphCard := EGA
  540.       ELSE IF HercPresent THEN
  541.          GraphCard := Herkules
  542.       ELSE
  543.          GraphCard := MDA
  544.    ELSE
  545.       IF VGAPres THEN
  546.          GraphCard := VGA
  547.       ELSE IF EGAPres THEN
  548.          GraphCard := EGA
  549.       ELSE
  550.          GraphCard := CGA;
  551.  
  552.  
  553.    {-------------------------------------------------------------------------
  554.      determine memory
  555.    --------------------------------------------------------------------------}
  556.  
  557.    DOS_Memory := MemW [$0000:$0413];
  558.    UsedMemory := PrefixSeg SHR 6;
  559.    Regs.AH := $88;
  560.    Intr ($15, Regs);
  561.    ExtendedMem := (((Regs.Flags AND FCarry) = 0) AND (Regs.AX <> 0));
  562.    IF ExtendedMem THEN
  563.       ExtendedMemSize := Regs.AX
  564.    ELSE IF (Typ = $FC) OR ((Typ >= $F5) AND (Typ <= $F8)) THEN BEGIN
  565.       Port [$70] := $30;
  566.       Dummy := Port [$71];
  567.       Port [$70] := $31;
  568.       ExtendedMemSize := Port [$71] * 256 + Dummy;
  569.       ExtendedMem := ExtendedMemSize > 0;
  570.       END;
  571.    ExpandedMem := EMM_Installed;
  572.    EMS_Base := 0;
  573.    IF ExpandedMem THEN BEGIN
  574.       ExpandedMemSize := EMS_Memory;
  575.       EMS_Version := GetEMSVersion;
  576.       EMS_Base    := GetEMSBase;
  577.       END;
  578.  
  579.    Segment := 0;
  580.    SystemMemory := 0;
  581.    MemExists := TRUE;
  582.    WHILE MemExists AND (Segment < CardMemBegin [GraphCard]) DO BEGIN
  583.       Inline ($FA);                         { disable interupts }
  584.       SaveByte := Mem [Segment:0];
  585.       Mem [Segment:0] := $55;
  586.       Dummy := Mem [Segment:0];
  587.       MemExists := (Dummy = $55);
  588.       Mem [Segment:0] := $AA;
  589.       Dummy := Mem [Segment:0];
  590.       MemExists := MemExists AND (Dummy = $AA);
  591.       Mem [Segment:0] := SaveByte;
  592.       Inline ($FB);                         { enable interupts }
  593.       Inc (Segment, $400);
  594.       IF MemExists THEN
  595.          Inc (SystemMemory, 16);
  596.    END;
  597.  
  598.    {-------------------------------------------------------------------------
  599.      determine diskette drives
  600.    --------------------------------------------------------------------------}
  601.  
  602.    DOS_Drives := 0;
  603.    DriveStr := '  (';
  604.    Regs.AH := $19;
  605.    Intr ($21, Regs);
  606.    DefaultDr := Regs.AL;
  607.    FOR L:=0 TO 8 DO BEGIN
  608.       Regs.AH := $0e;
  609.       Regs.DX := L;
  610.       Intr ($21, Regs);
  611.       Regs.AH := $19;
  612.       Intr ($21, Regs);
  613.       IF (Regs.AL = Regs.DX) THEN BEGIN
  614.          Inc (DOS_Drives);
  615.          DriveStr := DriveStr + Chr (L+65) + ':, ';
  616.          END;
  617.    END;
  618.    Regs.AH := $0e;
  619.    Regs.DX := DefaultDr;
  620.    Intr ($21, Regs);
  621.    IF DriveStr [Length(DriveStr)-1] = ',' THEN
  622.       Dec (DriveStr [0], 2);
  623.    DriveStr := DriveStr + ')';
  624.  
  625.    DriveByte := 0;
  626.    IF Typ = $FC THEN BEGIN
  627.       Port [$70] := $10;
  628.       DriveByte := Port [$71];
  629.       Drive1 := DriveByte AND 15;
  630.       NrDD := 0;
  631.       NrHD := 0;
  632.       Nr3DD := 0;
  633.       Nr3HD := 0;
  634.       CASE Drive1 OF
  635.           1: Inc (NrDD);
  636.           2: Inc (NrHD);
  637.           3: Inc (Nr3DD);
  638.           4: Inc (Nr3HD);
  639.       END;
  640.       Drive2 := DriveByte SHR 4;
  641.       CASE Drive2 OF
  642.           1: Inc (NrDD);
  643.           2: Inc (NrHD);
  644.           3: Inc (Nr3DD);
  645.           4: Inc (Nr3HD);
  646.       END;
  647.    END;
  648.  
  649.    DiskTypeStr := '';
  650.    IF DriveByte <> 0 THEN BEGIN
  651.       DiskTypeStr := '  (';
  652.       IF NrDD <> 0 THEN
  653.          DiskTypeStr := DiskTypeStr + Char (48+NrDD) + ' x 360 KB 5¼", ';
  654.       IF NrHD <> 0 THEN
  655.          DiskTypeStr := DiskTypeStr + Char (48+NrHD) + ' x 1.2 MB 5¼", ';
  656.       IF Nr3DD <> 0 THEN
  657.          DiskTypeStr := DiskTypeStr + Char (48+Nr3DD) + ' x 720 KB 3½", ';
  658.       IF Nr3HD <> 0 THEN
  659.          DiskTypeStr := DiskTypeStr + Char (48+Nr3HD) + ' x 1.44 MB 3½", ';
  660.       Dec (DiskTypeStr[0], 2);
  661.       DiskTypeStr := DiskTypeStr + ')';
  662.       END;
  663.  
  664.    {-------------------------------------------------------------------------
  665.      determine hard disks
  666.    --------------------------------------------------------------------------}
  667.  
  668.    Regs.AH := $08;                          { get drive parameters }
  669.    Regs.DL := $80;                          { of first harddisk }
  670.    Intr ($13, Regs);                        { BIOS disk interupt }
  671.    IF (Regs.Flags AND FCarry) <> 0 THEN     { error indicates no harddisk }
  672.       NrOfHardDisks := 0
  673.    ELSE
  674.       NrOfHardDisks := Regs.DL;             { else # of harddisk is returned }
  675.  
  676.    FOR L := 1 TO 4 DO BEGIN
  677.       Regs.AH := $10;                       { test drive ready }
  678.       Regs.DL := $7F + L;                   { of harddisk # L }
  679.       Intr ($13, Regs);                     { BIOS disk interupt }
  680.       IF ((Regs.Flags AND FCarry) <> 0) OR  { no error indicates drive exists }
  681.          (NrOfHardDisks = 0) THEN
  682.          Valid [$7F+L] := FALSE
  683.       ELSE BEGIN
  684.          Valid [$7F+L] := TRUE;
  685.          Dec (NrOfHardDisks);
  686.          END;
  687.    END;
  688.  
  689.    NrOfHardDisks := 0;
  690.    FOR L := $80 TO $83 DO BEGIN
  691.       IF Valid [L] THEN
  692.          Inc (NrOfHardDisks);
  693.    END;
  694.  
  695.  
  696.    {-------------------------------------------------------------------------
  697.      determine type of processor and coprocessor
  698.    --------------------------------------------------------------------------}
  699.  
  700.    IF MonoChromMode THEN
  701.       ScreenAddr := Ptr ($B000,0000)
  702.    ELSE
  703.       ScreenAddr := Ptr ($B800,0000);
  704.  
  705.    IF Debug THEN BEGIN
  706.       WriteLn;
  707.       FillChar (Result, SizeOf (ResultRec), 0);
  708.       Result.Speed287 := 1;
  709.       END;
  710.  
  711.    SpeedTest (Word (NOT Debug), Word(ExtendedMem), Word(ExpandedMem), MoveBuffer,
  712.               Ptr (EMS_Base, 0), ScreenAddr, Result);
  713.  
  714.    IF Debug THEN BEGIN
  715.       WriteLn ('RawMoveWTime: ', MoveWtime);
  716.       WriteLn ('RawMoveDTime: ', MoveDTime);
  717.       WriteLn ('CPU-Type:     ', CPUType);
  718.       WriteLn ('AAMTime:      ', AAMTime DIV 4);
  719.       WriteLn ('MoveBTime:    ', MoveBtime);
  720.       ReadLn;
  721.       END;
  722.  
  723.    CPU := Processor (CPUType);
  724.    Weitek := (NDPType AND $80) <> 0;
  725.    NDPType := NDPType AND $7F;            { clear Weitek flag }
  726.    ProcessorType := CPU_Name [CPU];
  727.  
  728.    IF NOT (CPU >= i286) THEN
  729.       ExtendedMem := FALSE;
  730.  
  731.    CacheSize (Debug, CPU > i286, FirstLevel, SecondLevel, CacheThru, Cache2Thru, MemThru);
  732.  
  733.  
  734.    {-------------------------------------------------------------------------
  735.      determine speed
  736.    --------------------------------------------------------------------------}
  737.  
  738.    Frequency  := 200 * AAM_Time [CPU] * ClockFreq / AAMTime;
  739.    MoveTakte  := MoveBTime * Frequency / (ClockFreq * 5000);
  740.    MoveWTakte := MoveWTime * Frequency / (ClockFreq * 5000);
  741.    IF CPU >= i386 THEN BEGIN
  742.       MoveWTime := MoveDTime DIV 2;   { because twice the # of words were moved}
  743.       END;
  744.    IF Debug THEN BEGIN
  745.       WriteLn ('MoveWTime:    ', MoveWtime);
  746.       WriteLn ('MoveDTime:    ', MoveDTime);
  747.       WriteLn ('MoveTakte:    ', MoveTakte:0:2);
  748.       WriteLn ('MoveTimeCPU:  ', MoveTime [CPU]);
  749.       WriteLn ('LFaktor:      ', LFaktor [CPU]);
  750.       WriteLn ('Frequency:    ', Frequency);
  751.       END;
  752.    ThruPut    := ClockFreq * 10000 / MoveWTime;
  753.    IF CPU >= i386 THEN
  754.       DataWidth := 32
  755.    ELSE
  756.       DataWidth:= 16;
  757.    WaitStates := (((((DataWidth DIV 8) * Frequency / (MoveTime [CPU] * 1024)) / MemThru)
  758.                  * MoveTime [CPU] - MoveTime [CPU]) * 0.5);
  759.    Index      := LFaktor[CPU] * Frequency/4.7e6 * (MoveTime [CPU] / MoveTakte);
  760.    FillTakte  := ScreenFillTime * Frequency / (ClockFreq * 5000);
  761.    IF Debug THEN BEGIN
  762.       WriteLn ('ScreenFillTim:', ScreenFillTime);
  763.       WriteLn ('FillTakte:    ', FillTakte);
  764.       WriteLn ('Index:        ', Index);
  765.       WriteLn ('BIOSWriteTime:', BIOSWriteTime);
  766.       END;
  767.    ScreenWaits:= Trunc (FillTakte - FillTime [CPU] + 0.1);
  768.  
  769.    IF Debug THEN BEGIN
  770.       WriteLn ('Stat87:       ', NDPType);
  771.       WriteLn ('Speed87:      ', Speed87);
  772.       WriteLn ('Speed287:     ', Speed287);
  773.       WriteLn ('Freq287:      ', 1e-6 * 7690 * ClockFreq /Speed287 :0:2);
  774.       END;
  775.  
  776.  
  777.    IF ExpandedMem THEN BEGIN
  778.       IF CPU >= i386 THEN
  779.          EMS_Thruput := ClockFreq * 16000 / EMS_Time
  780.       ELSE
  781.          EMS_ThruPut := ClockFreq * 10000 / EMS_Time;
  782.       END;
  783.  
  784.  
  785.    IF ExtendedMem THEN
  786.       Ext_ThruPut := ClockFreq * 10000 / Ext_Time;
  787.  
  788.    CASE NDPType OF             { 40 * # of clock cycles for FSQRT }
  789.    {Pentium}28: Frequency87 := 2760 * ClockFreq / Speed287;  { 70 clocks manual}
  790.    {EMC87}  27: Frequency87 := 1470 * ClockFreq / Speed287;  { 36 clocks meas.}
  791.    {83S87}  26: Frequency87 := 3040 * ClockFreq / Speed287;  { 76 clocks magazine}
  792.    {387+}   25: Frequency87 := 2880 * ClockFreq / Speed287;  { 76 clocks meas.}
  793.    {82S87}  24: Frequency87 := 3040 * ClockFreq / Speed287;  { 76 clocks magazine}
  794.    {82S87}  23: Frequency87 := 3040 * ClockFreq / Speed287;  { 72 clocks meas.}
  795.    {486} 30,22,29: Frequency87 := 3320 * ClockFreq / Speed287;  { 83 clocks meas.}
  796.    {RapidCAD}21:Frequency87 := 3320 * ClockFreq / Speed287;  { 83 clocks meas.}
  797.    {387DX}  20: Frequency87 := 4480 * ClockFreq / Speed287;  { 112 clocks meas.}
  798.    {38700sx}19: Frequency87 := 2200 * ClockFreq / Speed287;  { 55 clocks }
  799.    {38700DX}18: Frequency87 := 2040 * ClockFreq / Speed287;  { 52 clocks }
  800.    {83C87sx}17: Frequency87 := 3640 * ClockFreq / Speed287;  { 91 clocks magazine}
  801.    {83C87}  16: Frequency87 := 3440 * ClockFreq / Speed287;  { 86 clocks meas.}
  802.    {83S87}  15: Frequency87 := 1880 * ClockFreq / Speed287;  { 47 clocks meas.}
  803.    {83D87}  14: Frequency87 := 1470 * ClockFreq / Speed287;  { 36 clocks meas.}
  804.    {82S87}  13: Frequency87 := 1880 * ClockFreq / Speed287;  { 47 clocks }
  805.    {82S87}  12: Frequency87 := 1880 * ClockFreq / Speed287;  { 47 clocks }
  806.    {3C87sx} 11: Frequency87 := 2280 * ClockFreq / Speed287;  { 57 clocks DataSheet }
  807.    {3C87}   10: Frequency87 := 2240 * ClockFreq / Speed287;  { 57 clocks meas.}
  808.    {2C87}  8,9: Frequency87 := (1970 * ClockFreq / Speed287) * (0.928 + Index/65.0);  { 49 Takte }
  809.    {387sx}   7: Frequency87 := 5160 * ClockFreq / Speed287;  { 129 clocks }
  810.    {387}     6: Frequency87 := 5120 * ClockFreq / Speed287;  { 128 clocks meas. }
  811.    {287XL}   5: Frequency87 := 5440 * ClockFreq / Speed287;  { 136 clocks}
  812.    {287}     4: Frequency87 := (7690 * ClockFreq / Speed287) * (0.928 + Index/65.0);  {183 clocks meas.}
  813.    {80C187}  3: Frequency87 := 5440 * ClockFreq / Speed87;   { 136 clocks }
  814.    {8087}    2: Frequency87 := 7440 * ClockFreq / Speed87;   { 186 clocks meas.}
  815.    END;
  816.  
  817.    (* Correction for faster execution of coprocessor instructions with 486DLC *)
  818.  
  819.    IF (CPU = c486dlc) THEN
  820.       Frequency87 := Frequency87 / 1.055;
  821.  
  822.    Regs.AH := $30;
  823.    Intr ($21, Regs);
  824.    Version := Regs.AL+Regs.AH / 100.0;
  825.  
  826.    {---------------------------------------------------------------------------
  827.      speed of screen output
  828.    ---------------------------------------------------------------------------}
  829.  
  830.    TestStr := '                                                $';
  831.    SegTest := Seg (TestStr);
  832.    OfsTest := Ofs (TestStr)+1;
  833.    Start := Clock;
  834.       inline ($b9/$14/$00/
  835.               $b4/$02/
  836.               $b7/$00/
  837.               $b6/$1a/
  838.               $b2/$01/
  839.               $cd/$10/
  840.               $b4/$09/
  841.               $8e/$1e/SegTest/
  842.               $8b/$16/OfsTest/
  843.               $cd/$21/
  844.               $e2/$e8);
  845.    DosWriteTime := Clock - Start;
  846.  
  847.    IF Debug THEN BEGIN
  848.       GotoXY (1,25);
  849.       WriteLn ('DOSWriteTime: ', DOSWriteTime);
  850.       REPEAT UNTIL KeyPressed;
  851.       Read (Ch);
  852.       END;
  853.  
  854.    BIOSSpeed  := 20 * ClockFreq / BiosWriteTime;
  855.    DOSSpeed   := 1e6 / DOSWriteTime;
  856.  
  857.  
  858.    Regs.AX := $0C0F;    { clear keyboard buffer }
  859.    Intr ($21, Regs);
  860.    TestStr := 'n$'#8#8#8#8#8#8#8'       ';
  861.    Regs.AH := 9;
  862.    Regs.DS := Seg (TestStr);
  863.    Regs.DX := Ofs (TestStr)+1;
  864.    Intr ($21, Regs);
  865.    Regs.AH := $B;
  866.    Intr ($21, Regs);
  867.    ANSIPresent := (Regs.AL = $FF);
  868.    Regs.AX := $0C0F;    { clear keyboard buffer }
  869.    Intr ($21, Regs);
  870.  
  871.    FreeMem (MoveBuffer, 20000);
  872.    Emu := (Test8087 = 0) OR (NDPType < 2);
  873.  
  874.  
  875.    {-------------------------------------------------------------------------
  876.      output page 1
  877.    --------------------------------------------------------------------------}
  878.  
  879.    ClrScr;
  880.    WriteLn    ('══ public domain version ═══ COMPTEST  2.60 ═══════════════════════ '+'Page 1 ═══');
  881.    WriteLn;
  882.    WriteLn    ('computer type: ':37, ComputerType);
  883.    WriteLn    ('CPU: ':37, ProcessorType);
  884.    WriteLn    ('clock frequency: ':37, Frequency/1e6:0:2, ' MHz');
  885.    WriteLn    ('bus width: ':37, BusWidth[CPU], ' bit');
  886.    Write      ('CPU-cache: ':37);
  887.    IF FirstLevel <> 0 THEN BEGIN
  888.       Write ('1. level: ', FirstLevel, ' KB');
  889.       IF SecondLevel = 0 THEN
  890.          WriteLn
  891.       ELSE
  892.          WriteLn (', 2. level: ', SecondLevel, ' KB')
  893.       END
  894.    ELSE
  895.       WriteLn ('NOT FOUND');
  896.    WriteLn;
  897.    IF FirstLevel <> 0 THEN BEGIN
  898.       Write    ('maximum RAM thruput (without cache): ':37, MemThru:0:0, ' KB/s');
  899.       WriteLn    (' (effective wait states: ', Waitstates:0:1, ')');
  900.       Write   ('CPU-cache thruput: ':37, '1. level: ', CacheThru:0:0, ' KB/s');
  901.       IF SecondLevel <> 0 THEN
  902.          WriteLn (', 2. level: ', Cache2Thru:0:0, ' KB/s');
  903.       END
  904.    ELSE BEGIN
  905.       Write    ('maximum RAM-thruput: ':37, MemThru:0:0, ' KB/s');
  906.       WriteLn  (' (effective wait-states: ', Waitstates:0:1, ')');
  907.       END;
  908.    WriteLn;
  909.    WriteLn    ('system memory: ':37, SystemMemory:0, ' KB');
  910.    WriteLn    ('available to DOS: ':37, DOS_Memory:0, ' KB');
  911.    WriteLn    ('permanently used by DOS and TSRs: ':37, UsedMemory:0, ' KB');
  912.    WriteLn;
  913.    Write      ('extended memory: ':37);
  914.    IF ExtendedMem THEN
  915.       WriteLn (ExtendedMemSize:0, ' KB (INT 15h thruput: ', Ext_Thruput/1024:0:0, ' KB/s)')
  916.    ELSE
  917.       WriteLn ('NOT FOUND');
  918.    Write      ('expanded memory: ':37);
  919.    IF ExpandedMem THEN
  920.       WriteLn (ExpandedMemSize:0, ' KB (EMS ', EMS_Version, ', thruput: ', EMS_ThruPut/1024:0:0, ' KB/s)')
  921.    ELSE
  922.       WriteLn ('NOT FOUND');
  923.    WriteLn;
  924.    Write      ('other RAM: ':37);
  925.    SearchExtraRAM (FALSE);
  926.    WriteLn;
  927.    Write      ('BIOS-extensions: ':37);
  928.    SearchROM (FALSE);
  929.    WriteLn;
  930.    WriteLn    ('════════════════════════════ COMPTEST  2.60 ═══════════ (c) 1988-1994 N.J. ═══');
  931.    Write      ('Press a key for page 2');
  932.  
  933.    Ch := ReadKey;
  934.    ClrScr;
  935.    WriteLn    ('══ public domain version ═══ COMPTEST  2.60 ═══════════════════════ Page 2 ═══');
  936.    WriteLn;
  937.    WriteLn    ('parallel ports: ':37, NrParallelPorts:1);
  938.    Write      ('serial ports: ':37, NrSerialPorts:1);
  939.    Dummy := 0;
  940.    IF NrSerialPorts <> 0 THEN BEGIN
  941.       Write (' (');
  942.       FOR L := 1 TO 4 DO BEGIN
  943.          IF SIOType [L] <> 0 THEN BEGIN
  944.             Inc (Dummy);
  945.             Write ('COM', L, ': ', SIOTypeStr [SIOType[L]]);
  946.             IF Dummy <> NrSerialPorts THEN
  947.                Write (', ');
  948.             END;
  949.       END;
  950.       WriteLn (')');
  951.       END;
  952.  
  953.    Write ('mathematical coprocessor: ':37);
  954.    IF NDPType > 0 THEN BEGIN
  955.       Write (CoProcessor [NDPType]);
  956.       IF NDPType > 1 THEN
  957.          Write (' (clock frequency:', Frequency87/1e6:0:2, ' MHz)')
  958.       END;
  959.    IF Weitek THEN BEGIN
  960.       IF NDPType > 1 THEN BEGIN
  961.          Writeln;
  962.          Write ('':37);
  963.          END;
  964.       IF CPU >= i486 THEN
  965.          Writeln ('Weitek 4167')
  966.       ELSE
  967.          Writeln ('Weitek 3167 or 1167');
  968.       END;
  969.    IF (NDPType = 0) AND (NOT Weitek) THEN
  970.       WriteLn (CoProcessor [NDPType])
  971.    ELSE IF (NOT Weitek) THEN
  972.       WriteLn;
  973.  
  974.    WriteLn    ('mouse: ':37, Installed [MousePresent]);
  975.    WriteLn    ('games adaptor: ':37, Installed [GamesAdaptor]);
  976.    Writeln;
  977.    WriteLn    ('DOS drives: ':37, DOS_Drives:0, DriveStr);
  978.    Write      ('floppy drives: ':37, NrOfFloppies:0);
  979.    WriteLn    (DiskTypeStr);
  980.    WriteLn    ('hard disks: ':37, NrOfHardDisks:0);
  981.    WriteLn;
  982.    Write      ('graphics card: ':37, CardName [GraphCard]);
  983.    IF GraphCard = EGA THEN
  984.       WriteLn (' w/', EGAMem:4, ' KB')
  985.    ELSE
  986.       WriteLn;
  987.    WriteLn    ('video-RAM wait states: ':37, ScreenWaits);
  988.    WriteLn    ('speed of video output via BIOS: ':37, BIOSSpeed:0:0, ' characters/sec');
  989.    Write      ('speed of video output via DOS: ':37, DOSSpeed:0:0, ' characters/sec (');
  990.    IF ANSIPresent THEN
  991.      Write  ('with')
  992.    ELSE
  993.      Write  ('without');
  994.    WriteLn  (' ANSI driver)');
  995.    WriteLn    ('DOS version: ':37, Version:3:2);
  996.    WriteLn;
  997.    Write      ('Dhrystones/second: ':37);
  998.    Dhrys := Dhrystones (Index);
  999.    Write     (Dhrys:0:1);
  1000.    WriteLn   (' (CPU: ', Dhrys/3.6464E+2:0:1, '-fold of XT)');
  1001.    Write      ('Double-Precision Kilowhetstones: ':37);
  1002.    Whets := Whetstone (Emu, Index);
  1003.    Write      (Whets:0:1);
  1004.    IF Emu THEN
  1005.       WriteLn (' (emulator: ', Whets/4.9169E+0:0:1, '-fold of XT)')
  1006.    ELSE
  1007.       WriteLn (' (FPU: ', Whets/9.9087E+1:0:1, '-fold of XT w/ 8087)');
  1008.    Write     ('Double-Precision MFLOPS: ':37);
  1009.    MegaFlops := MFlops (Emu, Index);
  1010.    Write     (MegaFlops:0:3);
  1011.    IF Emu THEN
  1012.       WriteLn (' (emulator: ', MegaFlops/6.5242E-4:0:1, '-fold of XT)')
  1013.    ELSE
  1014.       WriteLn (' (FPU: ', MegaFlops/1.2446E-2:0:1, '-fold of XT w/ 8087)');
  1015.    WriteLn;
  1016.    WriteLn    ('════════════════════════════ COMPTEST  2.60 ═══════════ (c) 1988-1994 N.J. ═══');
  1017.    IF (NOT Weitek) THEN
  1018.       WriteLn;
  1019.    END; {with}
  1020.  
  1021.    IF Debug THEN BEGIN
  1022.       WriteLn ('Dhry: ', Dhrys);
  1023.       WriteLn ('Whet: ', Whets);
  1024.       WriteLn ('MFlop:', MegaFlops);
  1025.       Ch := ReadKey;
  1026.       END;
  1027.  
  1028.    IF NrOfHardDisks <> 0 THEN BEGIN
  1029.       Write   ('Test hard disk(s) (Y/N) ? ');
  1030.       Ch := ReadKey;
  1031.       IF UpCase (Ch) <> 'Y' THEN
  1032.          NrOfHardDisks := 0;
  1033.       END;
  1034.  
  1035.    IF (NrOfHardDisks > 0) THEN BEGIN
  1036.  
  1037.      ClrScr;
  1038.      WriteLn    ('══ public domain version ═══ COMPTEST  2.60 ═══════════════════════ Page 3 ═══');
  1039.  
  1040.      FOR L := $80 TO $83 DO BEGIN
  1041.  
  1042.        IF Valid [L] THEN BEGIN
  1043.  
  1044.           WriteLn;
  1045.  
  1046.           Regs.AH := $08;
  1047.           Regs.DL := L;
  1048.           Intr ($13, Regs);
  1049.           Sectors [L]   := Regs.CL AND $3F;
  1050.           Cylinders [L] := Word (Regs.CL AND $C0) * 4 + Regs.CH + 1;
  1051.           Heads [L]     := Regs.DH + 1;
  1052.           CylSize [L]   := LongInt (Sectors [L]) * Heads [L] * 512;
  1053.  
  1054.           ReserveMem;
  1055.  
  1056.           BufOff := Ofs (BufPtr^);
  1057.           BufSeg := Seg (BufPtr^);
  1058.  
  1059.           Regs.CX := 1;
  1060.           Regs.DL := L;
  1061.           Regs.DH := 0;
  1062.           Regs.AX := $0201;
  1063.           Regs.ES := BufSeg;
  1064.           Regs.BX := BufOff;
  1065.           Intr ($13, Regs);
  1066.  
  1067.           DOSCylinders [L] := 0;
  1068.           Dummy := $1C5;
  1069.           WHILE (Dummy < $200) AND ((BufPtr^[$1FF] * 256 + BufPtr^[$200]) = $55AA) DO BEGIN
  1070.              IF ((BufPtr^[Dummy] AND $C0) * 4 + BufPtr^[Dummy+1] + 1) > DOSCylinders [L] THEN
  1071.                  DOSCylinders [L]:= (BufPtr^[Dummy] AND $C0) * 4 + BufPtr^[Dummy+1]+1;
  1072.              Inc (Dummy, $10);
  1073.           END;
  1074.  
  1075.           FreeMem (BufPtr, Word(CylSize [L]+16));
  1076.           FreeMem (DummyPtr, FillSize);
  1077.  
  1078.           IF DOSCylinders [L] > Cylinders [L] THEN
  1079.              Cylinders [L] := DOSCylinders [L];
  1080.           SPC         := Sectors [L] * Heads [L];
  1081.           CylSize [L] := LongInt (512) * SPC;
  1082.           Capacity [L]:= CylSize [L] * Cylinders [L];
  1083.  
  1084.           ReserveMem;
  1085.  
  1086.           Write   ('hard disk ', L-$7F:1);
  1087.           WriteLn ('cylinders: ':26, Cylinders[L]);
  1088.           WriteLn ('read/write heads: ':37, Heads[L]);
  1089.           WriteLn ('sectors per track: ':37, Sectors[L]);
  1090.           WriteLn ('storage capacity: ':37, Capacity[L],  ' Byte (',Capacity[L] / 1048576.0:0:2,' MB)');
  1091.           WriteLn;
  1092.  
  1093.   {-------------------------------------------------------------------------
  1094.      determine track-to-track time
  1095.    --------------------------------------------------------------------------}
  1096.  
  1097.           Write   ('track-to-track seek time: ':37);
  1098.           Start := Clock;
  1099.           FOR Track := 0 TO Cylinders[L]-1 DO BEGIN
  1100.              Inline ($8b/$16/L/            { mov dx, Drive&Head }
  1101.                      $a1/Track/            { mov ax, Track }
  1102.                      $88/$c5/              { mov ch, al }
  1103.                      $25/$00/$03/          { and ax, $300 }
  1104.                      $d1/$e8/              { shr ax, 1 }
  1105.                      $d1/$e8/              { shr ax, 1 }
  1106.                      $0d/$01/$00/          { or  ax, Sector }
  1107.                      $88/$c1/              { mov cl, al }
  1108.                      $b4/$0c/              { mov ah, SeekFunc }
  1109.                      $cd/$13);             { int BIOS-DiskIO }
  1110.           END;
  1111.           TrackToTrack [L] := Int (((Clock-Start) / Cylinders[L]) * 10 + 0.5) / 10;
  1112.           WriteLn (TrackToTrack [L]:6:2, ' ms');
  1113.  
  1114.   {-------------------------------------------------------------------------
  1115.      determine average acces time
  1116.    --------------------------------------------------------------------------}
  1117.  
  1118.           Write   ('average seek time: ':37);
  1119.           Dummy := 2 * Cylinders [L] DIV 3;
  1120.           Start := Clock;
  1121.           FOR Track := 1 TO 40 DO BEGIN
  1122.              Inline ($8b/$16/L/            { mov dx, Drive&Head }
  1123.                      $a1/Dummy/            { mov ax, Track }
  1124.                      $88/$c5/              { mov ch, al }
  1125.                      $25/$00/$03/          { and ax, $300 }
  1126.                      $d1/$e8/              { shr ax, 1 }
  1127.                      $d1/$e8/              { shr ax, 1 }
  1128.                      $0d/$01/$00/          { or  ax, Sector }
  1129.                      $88/$c1/              { mov cl, al }
  1130.                      $b4/$0c/              { mov ah, SeekFunc }
  1131.                      $cd/$13);             { int BIOS-DiskIO }
  1132.              Dummy := Cylinders [L] - Dummy;
  1133.           END;
  1134.           AverageAccess [L] := Int ((Clock - Start) * 0.25 + 0.5) / 10;
  1135.           WriteLn (AverageAccess [L]:6:2, ' ms');
  1136.  
  1137.    {-------------------------------------------------------------------------
  1138.      maximum access time
  1139.    --------------------------------------------------------------------------}
  1140.  
  1141.           Write   ('maximum seek time: ':37);
  1142.           Dummy := 0;
  1143.           Start := Clock;
  1144.           FOR Track := 1 TO 25 DO BEGIN
  1145.              Inline ($8b/$16/L/            { mov dx, Drive&Head }
  1146.                      $a1/Dummy/            { mov ax, Track }
  1147.                      $88/$c5/              { mov ch, al }
  1148.                      $25/$00/$03/          { and ax, $300 }
  1149.                      $d1/$e8/              { shr ax, 1 }
  1150.                      $d1/$e8/              { shr ax, 1 }
  1151.                      $0d/$01/$00/          { or  ax, Sector }
  1152.                      $88/$c1/              { mov cl, al }
  1153.                      $b4/$0c/              { mov ah, SeekFunc }
  1154.                      $cd/$13);             { int BIOS-DiskIO }
  1155.              Dummy := (Cylinders[L]-1) - Dummy;
  1156.           END;
  1157.           MaximumAccess [L]:= Int ((Clock-Start) * 0.04 + 0.5);
  1158.           WriteLn (MaximumAccess[L]:6:2, ' ms');
  1159.  
  1160.  
  1161.    {-------------------------------------------------------------------------
  1162.      determine maximum thruput
  1163.    --------------------------------------------------------------------------}
  1164.  
  1165.          IF Debug THEN BEGIN
  1166.             WriteLn ('SPC: ', SPC);
  1167.             WriteLn ('BufSeg: ', Hex(BufSeg));
  1168.             WriteLn ('BufOff: ', Hex(BufOff));
  1169.             ReadLn;
  1170.             END;
  1171.  
  1172.           Write   ('maximum thruput: ':37);
  1173.           Delay (200);
  1174.           Dummy := 0;
  1175.           Start := Clock;
  1176.           FOR Track := 1 TO 15 DO BEGIN
  1177.              Inline ($8b/$16/L/            { mov dx, Drive&Head }
  1178.                      $a1/Dummy/            { mov ax, 0 }
  1179.                      $88/$c5/              { mov ch, al }
  1180.                      $25/$00/$03/          { and ax, $300 }
  1181.                      $d1/$e8/              { shr ax, 1 }
  1182.                      $d1/$e8/              { shr ax, 1 }
  1183.                      $0d/$01/$00/          { or  ax, Sector }
  1184.                      $88/$c1/              { mov cl, al }
  1185.                      $8b/$1e/BufOff/       { mov bx, BufOff }
  1186.                      $8e/$06/BufSeg/       { mov es, BufSeg }
  1187.                      $a1/SPC/              { mov ax, SectorPerTrack }
  1188.                      $b4/$02/              { mov ah, ReadFunc }
  1189.                      $cd/$13);             { int BIOS-DiskIO }
  1190.           END;
  1191.           DiskThruPut [L] := 15000 * (CylSize [L] DIV 1024) / (Clock-Start);
  1192.           Delay (200);
  1193.           Dummy := Cylinders [L] - 1;
  1194.           Head1 := Heads [L] - ((SPC + Sectors[L] - 1) DIV Sectors [L]);
  1195.           ErrByte := 0;
  1196.           FOR Track := 1 TO 16 DO BEGIN
  1197.              IF Track = 2 THEN
  1198.                 Start := Clock;
  1199.              Inline ($8b/$16/L/            { mov dx, Drive }
  1200.                      $8a/$36/Head1/        { mov dh, Head }
  1201.                      $a1/Dummy/            { mov ax, Track}
  1202.                      $88/$c5/              { mov ch, al }
  1203.                      $25/$00/$03/          { and ax, $300 }
  1204.                      $d1/$e8/              { shr ax, 1 }
  1205.                      $d1/$e8/              { shr ax, 1 }
  1206.                      $0d/$01/$00/          { or  ax, Sector }
  1207.                      $88/$c1/              { mov cl, al }
  1208.                      $8b/$1e/BufOff/       { mov bx, BufOff }
  1209.                      $8e/$06/BufSeg/       { mov es, BufSeg }
  1210.                      $a1/SPC/              { mov ax, SectorPerTrack }
  1211.                      $b4/$02/              { mov ah, ReadFunc }
  1212.                      $cd/$13/              { int BIOS-DiskIO }
  1213.                      $08/$26/ErrByte);     { or ErrByte, ah }
  1214.           END;
  1215.           Durchsatz := 15000 * (CylSize [L] DIV 1024) / (Clock-Start);
  1216.  
  1217.  
  1218.           IF Debug THEN BEGIN
  1219.              WriteLn;
  1220.              WriteLn ('thruput track 0: ', DiskThruput[L]);
  1221.              WriteLn ('thruput track ', Cylinders [L], ': ', Durchsatz);
  1222.              END;
  1223.  
  1224.           IF (ErrByte = 0)  AND (Durchsatz > DiskThruPut [L]) THEN
  1225.              DiskThruPut [L] := Durchsatz;
  1226.           Write   (DiskThruPut [L]:3:0, ' KB/sec');
  1227.  
  1228.  
  1229.    {--------------------------------------------------------------------------
  1230.      test if disk cache active
  1231.    --------------------------------------------------------------------------}
  1232.  
  1233.           Dummy := 2 * Cylinders [L] DIV 3;
  1234.           SPC := 16;
  1235.           FOR Track := 1 TO 10 DO BEGIN
  1236.              IF Track = 8 THEN
  1237.                 Start := Clock;
  1238.              Inline ($8b/$16/L/            { mov dx, Drive&Head }
  1239.                      $a1/Dummy/            { mov ax, Track }
  1240.                      $88/$c5/              { mov ch, al }
  1241.                      $25/$00/$03/          { and ax, $300 }
  1242.                      $d1/$e8/              { shr ax, 1 }
  1243.                      $d1/$e8/              { shr ax, 1 }
  1244.                      $0d/$01/$00/          { or  ax, Sector }
  1245.                      $88/$c1/              { mov cl, al }
  1246.                      $8b/$1e/BufOff/       { mov bx, BufOff }
  1247.                      $8e/$06/BufSeg/       { mov es, BufSeg }
  1248.                      $a1/SPC/              { mov ax, NrOfSectors }
  1249.                      $b4/$02/              { mov ah, ReadFunc }
  1250.                      $cd/$13);             { int BIOS-DiskIO }
  1251.              Dummy := Cylinders [L] - Dummy;
  1252.           END;
  1253.  
  1254.           CacheTstTime := Clock - Start;
  1255.  
  1256.           IF Debug THEN BEGIN
  1257.              WriteLn;
  1258.              WriteLn ('Cachetest: ', CacheTstTime);
  1259.              ReadLn;
  1260.              END;
  1261.  
  1262.           IF CPU < i286 THEN
  1263.              CacheOn [L] := CacheTstTime < 75 { 3 seeks, 24 KB read < 75 ms }
  1264.           ELSE
  1265.              CacheOn [L] := CacheTstTime < 50;{ 3 seeks, 24 KB read < 50 ms }
  1266.           IF CacheOn [L] THEN
  1267.              WriteLn (' (using disk cache)')
  1268.           ELSE
  1269.              WriteLn;
  1270.  
  1271.           FreeMem (BufPtr, Word(CylSize [L])+16);
  1272.           FreeMem (DummyPtr, FillSize);
  1273.           WriteLn;
  1274.        END;
  1275.  
  1276.        END;
  1277.        IF NrOfHardDisks = 1 THEN
  1278.           WriteLn (#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10);
  1279.        WriteLn    ('════════════════════════════ COMPTEST  2.60 ═══════════ (c) 1988-1994 N.J. ═══');
  1280.     END;
  1281.  
  1282.  
  1283.     IF (ParamCount > 0) AND (NOT Debug) OR (ParamCount > 1) AND Debug THEN BEGIN
  1284.       Assign  (Fil, ParamStr(1));
  1285.       Rewrite (Fil);
  1286.       WriteLn (Fil, '══ public domain version ═══ COMPTEST  2.60 ═══════════════════════ Page 1 ═══');
  1287.       WriteLn (Fil);
  1288.       WriteLn (Fil, 'computer type: ':37, ComputerType);
  1289.       WriteLn (Fil, 'CPU: ':37, ProcessorType);
  1290.       WriteLn (Fil, 'clock frequency: ':37, Frequency/1e6:0:2, ' Mhz');
  1291.       WriteLn (Fil, 'bus width: ':37, BusWidth[CPU], ' bit');
  1292.       Write   (Fil, 'CPU-cache: ':37);
  1293.       IF FirstLevel <> 0 THEN BEGIN
  1294.          Write (Fil, '1. level: ', FirstLevel, ' KB');
  1295.          IF SecondLevel = 0 THEN
  1296.             WriteLn (Fil)
  1297.          ELSE
  1298.             WriteLn (Fil, ', 2. level: ', SecondLevel, ' KB')
  1299.          END
  1300.       ELSE
  1301.          WriteLn (Fil, 'NOT FOUND');
  1302.       WriteLn (Fil);
  1303.       IF FirstLevel <> 0 THEN BEGIN
  1304.          Write    (Fil,'maximum RAM thruput (without cache): ':37, MemThru:0:0, ' KB/s');
  1305.          WriteLn  (Fil,' (effective wait states: ', Waitstates:0:1, ')');
  1306.          Write    (Fil,'CPU cache thruput: ':37, '1. level: ', CacheThru:0:0, ' KB/s');
  1307.          IF SecondLevel <> 0 THEN
  1308.             WriteLn (Fil,', 2. level: ', Cache2Thru:0:0, ' KB/s');
  1309.          END
  1310.       ELSE BEGIN
  1311.          Write    (Fil, 'maximum RAM thruput: ':37, MemThru:0:0, ' KB/s');
  1312.          WriteLn  (Fil, ' (effective wait states: ', Waitstates:0:1, ')');
  1313.       END;
  1314.       WriteLn (Fil);
  1315.       WriteLn (Fil, 'system memory: ':37, SystemMemory:0, ' KB');
  1316.       WriteLn (Fil, 'available for DOS: ':37, DOS_Memory:0, ' KB');
  1317.       WriteLn (Fil, 'permanently used by DOS and TSRs: ':37, UsedMemory:0, ' KB');
  1318.  
  1319.       WriteLn (Fil);
  1320.       Write   (Fil, 'extended memory: ':37);
  1321.       IF ExtendedMem THEN
  1322.          WriteLn (Fil, ExtendedMemSize:0, ' KB (INT 15h thruput: ', Ext_Thruput/1024:0:0, ' KB/s)')
  1323.       ELSE
  1324.          WriteLn (Fil, 'NOT FOUND');
  1325.       Write      (Fil, 'expanded memory: ':37);
  1326.       IF ExpandedMem THEN
  1327.          WriteLn (Fil, ExpandedMemSize:0, ' KB (EMS ', EMS_Version, ', thruput: ', EMS_ThruPut/1024:0:0, ' KB/s)')
  1328.       ELSE
  1329.          WriteLn (Fil, 'NOT FOUND');
  1330.       WriteLn (Fil);
  1331.       Write   (Fil, 'other RAM: ':37);
  1332.       SearchExtraRAM (TRUE);
  1333.       WriteLn (Fil);
  1334.       Write   (Fil, 'BIOS-extensions: ':37);
  1335.       SearchROM (TRUE);
  1336.       WriteLn (Fil);
  1337.       WriteLn (Fil, '════════════════════════════ COMPTEST  2.60 ═══════════ (c) 1988-1994 N.J. ═══');
  1338.       WriteLn (Fil);
  1339.       WriteLn (Fil, '══ public domain version ═══ COMPTEST  2.60 ═══════════════════════ Page 2 ═══');
  1340.       WriteLn (Fil);
  1341.       WriteLn (Fil, 'parallel ports: ':37, NrParallelPorts:1);
  1342.       Write   (Fil, 'serial ports: ':37, NrSerialPorts:1);
  1343.       Dummy := 0;
  1344.       IF NrSerialPorts <> 0 THEN BEGIN
  1345.          Write (Fil, ' (');
  1346.          FOR L := 1 TO 4 DO BEGIN
  1347.             IF SIOType [L] <> 0 THEN BEGIN
  1348.                Inc (Dummy);
  1349.                Write (Fil, 'COM', L, ': ', SIOTypeStr [SIOType[L]]);
  1350.                IF Dummy <> NrSerialPorts THEN
  1351.                   Write (Fil, ', ');
  1352.                END;
  1353.          END;
  1354.          WriteLn (Fil, ')');
  1355.          END;
  1356.  
  1357.    Write (Fil, 'mathematical coprocessor: ':37);
  1358.    IF Result.NDPType > 0 THEN BEGIN
  1359.       Write (Fil, CoProcessor [Result.NDPType]);
  1360.       IF Result.NDPType > 1 THEN
  1361.          Write (Fil, ' (clock frequency:', Frequency87/1e6:0:2, ' MHz)')
  1362.       END;
  1363.    IF Weitek THEN BEGIN
  1364.       IF Result.NDPType > 1 THEN BEGIN
  1365.          Writeln (Fil);
  1366.          Write (Fil, '':37);
  1367.          END;
  1368.       IF CPU >= i486 THEN
  1369.          Writeln (Fil, 'Weitek 4167')
  1370.       ELSE
  1371.          Writeln (Fil, 'Weitek 3167 or 1167');
  1372.       END;
  1373.    IF (Result.NDPType = 0) AND (NOT Weitek) THEN
  1374.       WriteLn (Fil, CoProcessor [Result.NDPType])
  1375.    ELSE IF (NOT Weitek) THEN
  1376.       WriteLn (Fil);
  1377.  
  1378.       WriteLn  (Fil, 'mouse: ':37, Installed [MousePresent]);
  1379.       WriteLn  (Fil, 'games adaptor: ':37, Installed [GamesAdaptor]);
  1380.       WriteLn  (Fil);
  1381.       WriteLn  (Fil, 'DOS drives: ':37, DOS_Drives:0, DriveStr);
  1382.       Write    (Fil, 'floppy drives: ':37, NrOfFloppies:0);
  1383.       WriteLn  (Fil, DiskTypeStr);
  1384.       WriteLn  (Fil, 'hard disks: ':37, NrOfHardDisks:0);
  1385.       WriteLn  (Fil);
  1386.       Write    (Fil, 'graphics card: ':37, CardName [GraphCard]);
  1387.       IF GraphCard = EGA THEN
  1388.          WriteLn (Fil, ' w/', EGAMem:4, ' KB')
  1389.       ELSE
  1390.          WriteLn (Fil);
  1391.       WriteLn  (Fil, 'video-RAM wait states: ':37, ScreenWaits);
  1392.       WriteLn  (Fil, 'speed of video output via BIOS: ':37, BIOSSpeed:0:0, ' characters/sec');
  1393.       Write    (Fil, 'speed of video output via DOS: ':37, DOSSpeed:0:0, ' characters/sec (');
  1394.       IF ANSIPresent THEN
  1395.          Write  (Fil, 'with')
  1396.       ELSE
  1397.          Write  (Fil, 'without');
  1398.       WriteLn   (Fil, ' ANSI driver)');
  1399.       WriteLn   (Fil, 'DOS version: ':37, Version:3:2);
  1400.       WriteLn   (Fil);
  1401.       Write     (Fil, 'Dhrystones/second: ':37);
  1402.       Write     (Fil, Dhrys:0:1);
  1403.       WriteLn   (Fil, ' (CPU: ', Dhrys/3.6464E+2:0:1, '-fold of XT)');
  1404.       Write     (Fil, 'Double-Precision Kilowhetstones: ':37);
  1405.       Write     (Fil, Whets:0:1);
  1406.       IF Emu THEN
  1407.          WriteLn (Fil, ' (emulator: ', Whets/4.9169E+0:0:1, '-fold of XT)')
  1408.       ELSE
  1409.          WriteLn (Fil, ' (FPU: ', Whets/9.7087E+1:0:1, '-fold of XT w/ 8087)');
  1410.       Write     (Fil, 'Double-Precision MFLOPS: ':37);
  1411.       Write     (Fil, MegaFlops:0:3);
  1412.       IF Emu THEN
  1413.          WriteLn (Fil, ' (emulator: ', MegaFlops/6.5242E-4:0:1, '-fold of XT)')
  1414.       ELSE
  1415.          WriteLn (Fil, ' (FPU: ', MegaFlops/1.2446E-2:0:1, '-fold of XT w/ 8087)');
  1416.       WriteLn   (Fil);
  1417.       WriteLn   (Fil, '════════════════════════════ COMPTEST  2.60 ═══════════ (c) 1988-1994 N.J. ═══');
  1418.       WriteLn   (Fil);
  1419.       IF NrOfHardDisks = 0 THEN
  1420.          Close (Fil)
  1421.       ELSE BEGIN
  1422.          WriteLn   (Fil, '══ public domain version ═══ COMPTEST  2.60 ═══════════════════════ Page 3 ═══');
  1423.          WriteLn   (Fil);
  1424.  
  1425.          FOR L := $80 TO $7F+NrOfHardDisks DO BEGIN
  1426.  
  1427.            Write   (Fil, 'hard disk ', L-$7F:1);
  1428.            WriteLn (Fil, 'cylinders: ':26, Cylinders[L]);
  1429.            WriteLn (Fil, 'read/write heads: ':37, Heads[L]);
  1430.            WriteLn (Fil, 'sectors per track: ':37, Sectors[L]);
  1431.            WriteLn (Fil, 'storage capacity: ':37, Capacity[L],  ' Byte (',Capacity[L] / 1048576.0:0:2,' MB)');
  1432.            WriteLn (Fil);
  1433.            WriteLn (Fil, 'track-to-track seek time: ':37, TrackToTrack [L]:6:2, ' ms');
  1434.            WriteLn (Fil, 'average seek time: ':37, AverageAccess [L]:6:2, ' ms');
  1435.            WriteLn (Fil, 'maximum seek time: ':37, MaximumAccess[L]:6:2, ' ms');
  1436.            Write   (Fil, 'maximum thruput: ':37, DiskThruPut [L]:3:0, ' KB/sec');
  1437.            IF CacheOn [L] THEN
  1438.               WriteLn (Fil, ' (using disk cache)')
  1439.            ELSE
  1440.               WriteLn (Fil);
  1441.            WriteLn (Fil);
  1442.            WriteLn (Fil);
  1443.  
  1444.         END;
  1445.  
  1446.         WriteLn (Fil, '════════════════════════════ COMPTEST  2.60 ═══════════ (c) 1988-1994 N.J. ═══');
  1447.         END;
  1448.       Close (Fil);
  1449.       END;
  1450.       IF IOResult <> 0 THEN
  1451.          BEGIN END;
  1452.       Write   ('COMPTEST terminated - press any key');
  1453.       Ch := ReadKey;
  1454.  
  1455. END.
  1456.